home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1996 September / JCSM Shareware Collection (JCS Distribution) (September 1996).ISO / prgtools / euphor13.zip / GRAPHICS.E < prev    next >
Text File  |  1995-05-14  |  6KB  |  234 lines
  1.         ----------------------
  2.         -- Graphics & Sound --
  3.         ----------------------
  4.  
  5. --    GRAPHICS MODES --  argument to graphics_mode()
  6.  
  7. -- mode  description
  8. -- ----  -----------
  9. --   -1  restore to original default mode
  10. --    0  40 x 25 text, 16 grey
  11. --    1  40 x 25 text, 16/8 color
  12. --    2  80 x 25 text, 16 grey
  13. --    3  80 x 25 text, 16/8 color
  14. --    4  320 x 200, 4 color
  15. --    5  320 x 200, 4 grey
  16. --    6  640 x 200, BW
  17. --    7  80 x 25 text, BW
  18. --   11  720 x 350, BW  (many video cards are lacking this one)
  19. --   13  320 x 200, 16 color
  20. --   14  640 x 200, 16 color
  21. --   15  640 x 350, BW  (may be 4-color with blinking)
  22. --   16  640 x 350, 4 or 16 color
  23. --   17  640 x 480, BW
  24. --   18  640 x 480, 16 color
  25. --   19  320 x 200, 256 color
  26. --  256  640 x 400, 256 color
  27. --  257  640 x 480, 256 color
  28. --  258  800 x 600, 16 color
  29. --  259  800 x 600, 256 color
  30. --  260  1024 x 768, 16 color
  31. --  261  1024 x 768, 256 color
  32. --  262  1280 x 1024, 16 color (not many cards have 262,263)
  33. --  263  1280 x 1024, 256 color
  34.  
  35. -- COLOR values -- for characters and pixels
  36. global constant BLACK = 0,
  37.         BLUE  = 1,
  38.         GREEN = 2,
  39.         CYAN =  3,
  40.         RED   = 4,
  41.         MAGENTA = 5,
  42.         BROWN = 6,
  43.         WHITE = 7,
  44.         GRAY  = 8,
  45.         BRIGHT_BLUE = 9,
  46.         BRIGHT_GREEN = 10,
  47.         BRIGHT_CYAN = 11,
  48.         BRIGHT_RED = 12,
  49.         BRIGHT_MAGENTA = 13,
  50.         YELLOW = 14,
  51.         BRIGHT_WHITE = 15
  52.  
  53. global constant BLINKING = 16  -- add to color to get blinking text
  54.  
  55.  
  56. -- machine() commands
  57. constant M_SOUND          = 1,
  58.      M_LINE           = 2,
  59.      M_PALETTE        = 3,
  60.      M_PIXEL          = 4,
  61.      M_GRAPHICS_MODE  = 5,
  62.      M_CURSOR         = 6,
  63.      M_WRAP           = 7,
  64.      M_SCROLL         = 8,
  65.      M_SET_T_COLOR    = 9,
  66.      M_SET_B_COLOR    = 10,
  67.      M_POLYGON        = 11,
  68.      M_TEXTROWS       = 12,
  69.      M_VIDEO_CONFIG   = 13,
  70.      M_ELLIPSE        = 18,
  71.      M_GET_PIXEL      = 21,
  72.      M_GET_POSITION   = 25,
  73.      M_ALL_PALETTE    = 27
  74.  
  75. type mode(integer x)
  76.     return (x >= -3 and x <= 19) or (x >= 256 and x <= 263)
  77. end type
  78.  
  79. type color(integer x)
  80.     return x >= 0 and x <= 255
  81. end type
  82.  
  83. type boolean(integer x)
  84.     return x = 0 or x = 1
  85. end type
  86.  
  87. type positive_int(integer x)
  88.     return x >= 1
  89. end type
  90.  
  91. type point(sequence x)
  92.     return length(x) = 2
  93. end type
  94.  
  95. type multi_point(sequence x)
  96.     return length(x) = 2 or length(x) = 3
  97. end type
  98.  
  99. type point_sequence(sequence x)
  100.     return length(x) >= 2
  101. end type
  102.  
  103. global procedure draw_line(color c, point_sequence xyarray)
  104. -- draw a line connecting the 2 or more points
  105. -- in xyarray: {{x1, y1}, {x2, y2}, ...}
  106. -- using a certain color 
  107.     machine_proc(M_LINE, {c, 0, xyarray})
  108. end procedure
  109.  
  110. global procedure polygon(color c,
  111.              boolean fill,
  112.              point_sequence xyarray)
  113. -- draw a polygon using a certain color
  114. -- fill the area if fill is TRUE
  115. -- 3 or more vertices are given in xyarray
  116.     machine_proc(M_POLYGON, {c, fill, xyarray})
  117. end procedure
  118.  
  119. global procedure ellipse(color c, boolean fill, point p1, point p2)
  120. -- draw an ellipse with a certain color that fits in the
  121. -- rectangle defined by diagonal points p1 and p2, i.e. 
  122. -- {x1, y1} and {x2, y2}. The ellipse may be filled or just an outline.   
  123.     machine_proc(M_ELLIPSE, {c, fill, p1, p2})
  124. end procedure
  125.  
  126. global procedure pixel(object c, point p)
  127. -- set the color for a single pixel (when c is an atom)
  128. -- or a horizontal line of pixels (when c is a sequence)
  129.     machine_proc(M_PIXEL, {c, p})
  130. end procedure
  131.  
  132. global function get_pixel(multi_point p)
  133. -- read color number of a single pixel when p is {x, y}, or
  134. -- read a horizontal line of pixels, when p is {x, y, length} 
  135.     return machine_func(M_GET_PIXEL, p)
  136. end function
  137.  
  138. global function graphics_mode(mode m)
  139. -- try to set up a new graphics mode
  140. -- return 0 if successful, non-zero if failed
  141.    return machine_func(M_GRAPHICS_MODE, m)
  142. end function
  143.  
  144. global constant VC_COLOR = 1,
  145.         VC_MODE  = 2,
  146.         VC_LINES = 3,
  147.         VC_COLUMNS = 4,
  148.         VC_XPIXELS = 5,
  149.         VC_YPIXELS = 6,
  150.         VC_NCOLORS = 7,
  151.         VC_PAGES = 8
  152. global function video_config()
  153. -- return sequence of information on video configuration
  154. -- {color?, mode, text lines, text columns, xpixels, ypixels, #colors, pages}
  155.     return machine_func(M_VIDEO_CONFIG, 0)
  156. end function
  157.  
  158. -- cursor styles:
  159. global constant NO_CURSOR  = 8192,
  160.      UNDERLINE_CURSOR  = 1543,
  161.      BLOCK_CURSOR      = 7,
  162.      HALF_BLOCK_CURSOR = 1031
  163.  
  164. global procedure cursor(integer style)
  165. -- choose a cursor style
  166.     machine_proc(M_CURSOR, style)
  167. end procedure
  168.  
  169. global function get_position()
  170. -- return {line, column} of current cursor position
  171.     return machine_func(M_GET_POSITION, 0)
  172. end function
  173.  
  174. global function text_rows(positive_int rows)
  175.     return machine_func(M_TEXTROWS, rows)
  176. end function
  177.  
  178. global procedure wrap(boolean on)
  179. -- on = 1: characters will wrap at end of long line
  180. -- on = 0: lines will be truncated
  181.     machine_proc(M_WRAP, on)
  182. end procedure
  183.  
  184. global procedure scroll(integer amount, 
  185.             positive_int top_line, 
  186.             positive_int bottom_line)
  187. -- scroll lines of text on screen between top_line and bottom_line
  188. -- amount > 0: scroll text up by amount lines
  189. -- amount < 0: scroll text down by amount lines
  190. -- (had only the first parameter in v1.2)   
  191.     machine_proc(M_SCROLL, {amount, top_line, bottom_line})
  192. end procedure
  193.  
  194. global procedure text_color(color c)
  195. -- set the foreground text color to c - text or graphics modes
  196. -- add 16 to get blinking
  197.     machine_proc(M_SET_T_COLOR, c)
  198. end procedure
  199.  
  200. global procedure bk_color(color c)
  201. -- set the background color to c - text or graphics modes
  202.     machine_proc(M_SET_B_COLOR, c)
  203. end procedure
  204.  
  205. type mixture(sequence s)
  206.     return length(s) = 3 -- {red, green, blue}
  207. end type
  208.  
  209. global function palette(color c, mixture s)
  210. -- choose a new mix of {red, green, blue} to be shown on the screen for
  211. -- color number c. Returns previous mixture as {red, green, blue}.
  212.     return machine_func(M_PALETTE, {c, s})
  213. end function
  214.  
  215. global procedure all_palette(sequence s)
  216. -- s is a sequence of the form: {{r,g,b},{r,g,b}, ...{r,g,b}}
  217. -- that specifies new color intensities for the entire set of
  218. -- colors in the current graphics mode.  
  219.     machine_proc(M_ALL_PALETTE, s)
  220. end procedure
  221.  
  222. -- Sound Effects --
  223.  
  224. type frequency(integer x)
  225.     return x >= 0
  226. end type
  227.  
  228. global procedure sound(frequency f)
  229. -- turn on speaker at frequency f
  230. -- turn off speaker if f is 0
  231.     machine_proc(M_SOUND, f)
  232. end procedure
  233.  
  234.